home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / gopher.el.z / gopher.el
Encoding:
Text File  |  1998-05-21  |  54.6 KB  |  1,692 lines

  1. ;;; gopher.el --- an emacs gopher client
  2.  
  3. ;; Copyright (C) 1992 scott snyder
  4.  
  5. ;; Author: scott snyder <snyder@fnald0.fnal.gov>
  6. ;; Created: 29 Jun 1992
  7. ;; Version: 1.03
  8. ;; Keywords: gopher, comm
  9.  
  10. ;; LCD Archive Entry:
  11. ;; gopher|scott snyder|snyder@fnald0.fnal.gov|
  12. ;; An emacs gopher client.|
  13. ;; 20-Apr-1993|1.02|~/interfaces/gopher.el.Z|
  14.  
  15. ;; This file is not part of GNU Emacs, but is distributed under the
  16. ;; same conditions.
  17. ;;
  18. ;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  20. ;; accepts responsibility to anyone for the consequences of using it
  21. ;; or for whether it serves any particular purpose or works at all,
  22. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  23. ;; License for full details.
  24. ;;
  25. ;; Everyone is granted permission to copy, modify and redistribute
  26. ;; GNU Emacs, but only under the conditions described in the
  27. ;; GNU Emacs General Public License.   A copy of this license is
  28. ;; supposed to have been given to you along with GNU Emacs so you
  29. ;; can know your rights and responsibilities.  It should be in a
  30. ;; file named COPYING.  Among other things, the copyright notice
  31. ;; and this notice must be preserved on all copies.
  32. ;;
  33. ;;; Synched up with: Not in FSF.
  34. ;;
  35. ;; An emacs gopher client.  Currently supports directory, text, CSO,
  36. ;; index, image, and telnet objects.
  37. ;; Requires forms.el and background.el.
  38. ;; 
  39. ;; Written by scott snyder <snyder@fnald0.fnal.gov>
  40. ;; Some code borrowed from GNUS (by Masanobu UMEDA).
  41. ;; Some code (bookmarks, xterms, error handling) contributed
  42. ;; by Stewart Clamen <clamen@cs.cmu.edu>.
  43.  
  44. ;;; Commentary:
  45. ;; OPERATING INSTRUCTIONS
  46. ;;
  47. ;; To use, `M-x gopher'.  To specify a different root server, use
  48. ;; `C-u M-x gopher'.  If you want to use bookmarks, set the variable
  49. ;; gopher-support-bookmarks appropriately.
  50. ;; The command `M-x gopher-atpoint' will attempt to interpret the text
  51. ;; around point as a gopher bookmark specification and will retrieve
  52. ;; that item.
  53. ;;
  54. ;; Sample .emacs configuration:
  55. ;;  (autoload 'gopher "gopher")
  56. ;;  (autoload 'gopher-atpoint "gopher")
  57. ;;  (setq gopher-support-bookmarks t)
  58. ;;
  59. ;; In directory mode:
  60. ;;   Space, return, `f', or `e' selects the line point is on.
  61. ;;   With a numeric prefix argument, select that object.
  62. ;;   `q', `l', or `u' will return to the previous node.
  63. ;;   `n' and `p' to the next and previous lines.
  64. ;;   `a' will add an object to your bookmark list.
  65. ;;   `v' will display your bookmark list.
  66. ;;   `=' gives detailed information about an object.
  67. ;;  In the bookmark list, all of the above (except `a'), plus:
  68. ;;   `C-k' will delete an object from the bookmark list.
  69. ;;   `C-y' will yank the most recently deleted bookmark object back into
  70. ;;         the bookmark buffer.
  71. ;;   `s' will save the bookmark list.
  72. ;;   `Q' will quit gopher entirely, killing all gopher buffers.
  73. ;;
  74. ;;   All commands which operate on a specific object can take an optional
  75. ;;   numeric prefix argument giving the index of the object on which
  76. ;;   to operate.
  77. ;;
  78. ;; In document mode:
  79. ;;   Space pages forward.
  80. ;;   Delete pages backward.
  81. ;;   `q', `l' or `u' returns to the last node.
  82. ;;
  83. ;; In the CSO entry form:
  84. ;;    `C-c RET' performs a look-up, based on the field contents
  85. ;;      you've filed in.
  86. ;;    `C-c l' returns to the previous node.
  87. ;;
  88. ;; Telnets:
  89. ;;    If you have an X server set, gopher will try to create an xterm
  90. ;;    running telnet.  If not, the emacs-lisp telnet mode will be used.
  91. ;;    From the emacs-lisp telnet mode, use `C-c l' to kill the session
  92. ;;    and return to the previous node.
  93. ;;    See also the variable gopher-telnet-command.
  94. ;;
  95. ;; Images:
  96. ;;    Images are displayed using the command gopher-image-display-command.
  97. ;;    The default setting for this variable uses xv.
  98. ;;
  99. ;; Note:
  100. ;;   If gopher consistently hangs while trying to retrieve an object,
  101. ;;   try turning on gopher-buggy-accept (which see).
  102. ;;
  103. ;; VMS notes:
  104. ;;   To use this on VMS, you'll need my emacs subprocess patches (recently
  105. ;;   posted on gnu.emacs.sources; if you can't find them, send me mail).
  106. ;;   To be able to run telnet in a separate decterm, you'll also need
  107. ;;   to (setq shell-file-name "docmd") and create the file
  108. ;;   emacs_library:[etc]docmd.com containing the following:
  109. ;;     $ if p1 .eqs. "-C" then p1 = ""
  110. ;;     $ deass sys$input
  111. ;;     $ 'p1 'p2 'p3 'p4 'p5 'p6 'p7 'p8
  112. ;;     $ eoj
  113.  
  114. ;;; Change Log:
  115. ;;
  116. ;; Version 1.03    30-APR-1993
  117. ;;  * Add a buffer-local variable gopher-obj to all gopher buffers bound
  118. ;;    to the description of the object contained in that buffer.
  119. ;;
  120. ;; Version 1.02    20-APR-1993 
  121. ;;  * Avoid using replace-regexp in gopher-clean-text.  (Suggested by
  122. ;;    sbyrnes@rice.edu (Steven Byrnes)).
  123. ;;  * Added gopher-port-aliases.
  124. ;;  * Print ports as strings in gopher-directory-show-object.
  125. ;;  * Don't (ding) when the net stream closes unexpectedly.
  126. ;;  * Added image display (based on code from beldar@MicroUnity.com
  127. ;;    (Gardner Cohen)).
  128. ;;  * Attempt to improve error reporting.
  129. ;;  * Reworked gopher-parse-bookmark to handle out-of-order fields.
  130. ;;  * Added gopher-atpoint.
  131. ;;  * Moved bookmark init stuff to gopher-read-bookmarks.
  132. ;;  * Added gopher-quit (based on code from Thomas L|fgren
  133. ;;    <tde9104@abacus.hgs.se>).
  134. ;;  * Change usage of background for XEmacs.
  135. ;;    (Patch from "William M. Perry" <wmperry@raisin.ucs.indiana.edu>).
  136. ;;  * Added a (provide 'gopher) at end.
  137. ;;  * Added `f' and `e' bindings in directory mode.
  138. ;;    
  139. ;; Version 1.01
  140. ;;  * Added patch suggested by Humberto Ortiz-Zuazaga
  141. ;;    <zuazaga@ucunix.san.uc.EDU> to allow null Path= items in .gopherrc.
  142. ;;
  143. ;; Version 1.00    29-AUG-1992
  144. ;;  * Added gopher-buggy-accept.
  145. ;;  * Reworked telnet stuff to use an arbitrary command string to start up
  146. ;;    the telnet process.  This can be used to start the telnet in a
  147. ;;    separate terminal window.
  148. ;;    Based on code from Stewart Clamen.
  149. ;;  * Stewart Clamen <clamen@cs.cmu.edu> added bookmarks.
  150. ;;  * Added 's key binding to save bookmarks.
  151. ;;  * Added a prefix argument to gopher-directory-buffer and
  152. ;;    gopher-add-bookmark.
  153. ;;  * Added standard emacs-lisp header.
  154. ;;  * Stewart Clamen <clamen@cs.cmu.edu> added some error trapping and
  155. ;;    recovery (gopher-retrieve-document-cleanly).
  156. ;;  * Appended node description to the node's buffer's name.
  157. ;;  * Reformat bookmark buffers when returning to them via gopher-last-node
  158. ;;    or when an item is deleted.
  159. ;;  * Added gopher-yank-bookmark.
  160. ;;  * Added gopher-bookmark-modified-tick to prevent reformatting bookmark
  161. ;;    buffers needlessly.
  162. ;;
  163. ;; Version 0.92    27-JUL-1992
  164. ;;  * Added gopher-hostname-aliases.
  165. ;;
  166. ;; Version 0.91    30-JUN-1992
  167. ;;  * Deal with servers which send stuff after the CR.
  168. ;;  * Prevent gopher-directory-show-object from clearing the read-only flag.
  169. ;;  * Allow specification of port number in `C-u M-x gopher'.
  170. ;;
  171. ;; Version 0.9     29-JUN-1992
  172. ;;  * Initial release.
  173.  
  174. ;;; Code:
  175.  
  176. (require 'electric)
  177. (require 'forms)
  178.  
  179. ;; background has the same name as an epoch function. 
  180. ;; Rename it to gopher-background...
  181. ;; also, the version i got from the archive didn't have a provide...
  182. (cond ((and (string-lessp "19" emacs-version)
  183.         (not (boundp 'epoch::version)))
  184.        ;; background is obsolete in emacs19: just add a & to shell-command.
  185.        (defun gopher-background (command)
  186.      (shell-command (concat command "&"))))
  187.       (t
  188.        ;; background has the same name as an epoch function. 
  189.        ;; Rename it to gopher-background...
  190.        ;; also, the version i got from the archive didn't have a provide...
  191.        (if (not (fboundp 'gopher-background))
  192.        (if (fboundp 'background)
  193.            (let ((old-background (symbol-function 'background)))
  194.          (load-library "background")
  195.          (fset 'gopher-background (symbol-function 'background))
  196.          (fset 'background old-background))
  197.          (load-library "background")
  198.          (fset 'gopher-background (symbol-function 'background))
  199.          ))
  200.        ))
  201.  
  202. (defgroup gopher nil
  203.   "Emacs gopher client."
  204.   :group 'hypermedia
  205.   :group 'comm)
  206.  
  207.  
  208. (defcustom gopher-root-node (vector ?1 "root" "" "ucs_gopher" 70)
  209.   "The root gopher server, as a gopher object."
  210.   :type '(vector character string string
  211.          (string :tag "Host")
  212.          (integer :tag "Port"))
  213.   :group 'gopher
  214.   :group 'local)
  215.  
  216. (defcustom gopher-directory-mode-hook nil
  217.   "*Invoked when entering a new gopher directory."
  218.   :type 'hook
  219.   :group 'gopher)
  220. (defvar gopher-directory-mode-map (make-keymap)
  221.   "Keymap for gopher-directory-mode.")
  222.  
  223. (defcustom gopher-document-mode-hook nil
  224.   "*Invoked when showing gopher document."
  225.   :type 'hook
  226.   :group 'gopher)
  227. (defvar gopher-document-mode-map (make-keymap)
  228.   "Keymap for gopher-document-mode.")
  229.  
  230. (defcustom gopher-form-mode-hooks nil
  231.   "*Invoked with entering a gopher form (i.e., for CSO)."
  232.   :type 'hook
  233.   :group 'gopher)
  234. (defvar gopher-form-mode-map (make-keymap)
  235.   "Keymap for gopher-form-mode.")
  236.  
  237. (defvar gopher-tmp-buf nil
  238.   "Buffer used to receive output from gopher.")
  239.  
  240. (defcustom gopher-debug-read t
  241.   "*If non-nil, show the current status about reading the gopher server output."
  242.   :type 'boolean
  243.   :group 'gopher)
  244.  
  245. ;; On some systems (such as SGI Iris), accept-process-output doesn't seem
  246. ;; to return for the last packet received on a connection.  Turn this on
  247. ;; to work around the problem, but does anyone know what causes this?
  248. (defcustom gopher-buggy-accept nil
  249.   "*If non-nil, use sit-for instead of accept-process-output.
  250. If gopher consistently hangs while fetching an object, try turning this on."
  251.   :type 'boolean
  252.   :group 'gopher)
  253.  
  254. (defcustom gopher-hostname-aliases
  255.   '(("128.230.33.31" . "oliver.syr.edu"))
  256.   "Emacs can't deal with raw IP addresses used as a hostname.
  257. Use this to work around..."
  258.   :type '(repeat (cons (string :tag "IP Address")
  259.                (string :tag "Host Name")))
  260.   :group 'gopher)
  261.  
  262. (defcustom gopher-port-aliases
  263.   '(("whois_port" . 43))
  264.   "Some losing hosts send a port name instead of a number.
  265. Use this table to convert..."
  266.   :type '(repeat (cons (string :tag "Named Port")
  267.                (integer :tag "Port Number")))
  268.   :group 'gopher)
  269.  
  270.  
  271. (defcustom gopher-support-bookmarks nil
  272.   "*If nil, do not implement bookmarks. 
  273. If 'unix or t, read and write bookmarks to ~/.gopherrc. 
  274. If a filename, read and save vector from there directly (not implemented yet).
  275. If a vector, treat as a built-in directory."
  276.   :type '(choice (const :tag "off" nil)
  277.          (const t) (const unix)
  278.          file
  279.          vector)
  280.   :group 'gopher)
  281.  
  282. (defconst gopher-bookmarks nil "Internal bookmark directory.")
  283. (defconst gopher-bookmarks-modified nil "Do bookmarks need to be saved?")
  284. (defconst gopher-killed-bookmark nil "The last bookmark object to be killed")
  285. (defconst gopher-bookmark-directory-p nil
  286.   "Is this buffer a bookmark directory?  A buffer-local variable.")
  287.  
  288. (defvar gopher-bookmark-modified-tick 0
  289.   "Counts each time the bookmark vector is modified.")
  290.  
  291.  
  292. (defcustom gopher-telnet-command
  293.   (cond ((eq system-type 'vax-vms)
  294.          (if (getenv "DECW$DISPLAY")
  295.              "create/terminal/wait/window=(title=\"telnet\") telnet"))
  296.         (t
  297.          (if (getenv "DISPLAY")
  298.              "xterm -e telnet"))
  299.         )
  300.   "*Command to use to start a telnet session.
  301. If this is nil, the emacs-lisp telnet package will be used.
  302. The default setting is to create a terminal window running telnet
  303. if you've specified an X server, and to use the emacs-lisp telnet otherwise."
  304.   :type '(choice (const nil) string)
  305.   :group 'gopher)
  306.  
  307.  
  308. (defcustom gopher-image-display-command "xv -geometry +200+200"
  309.   "*The command used to try to display an image object."
  310.   :type 'string
  311.   :group 'gopher)
  312.  
  313.  
  314. (defcustom gopher-object-type-alist
  315.   '(( ?0   ""          gopher-document-object)
  316.     ( ?1   "/"         gopher-directory-object)
  317.     ( ?2   " <CSO>"    gopher-cso-object)
  318.     ( ?3   " <error>"  gopher-unimplemented-object)
  319.     ( ?4   " <binhex>" gopher-binary-object)
  320.     ( ?5   " <DOS>"    gopher-binary-object)
  321.     ( ?6   " <UU>"     gopher-binary-object)
  322.     ( ?7   " <?>"      gopher-index-object)
  323.     ( ?8   " <TEL>"    gopher-telnet-object)
  324.     ( ?9   " <bin>"    gopher-binary-object)
  325.     ( ?T   " <T>"      gopher-unimplemented-object)
  326.     ( ?s   " <)"       gopher-binary-object)
  327.     ( ?M   " <MIME>"   gopher-unimplemented-object)
  328.     ( ?h   " <html>"   gopher-unimplemented-object)
  329.     ( ?I   " <image>"  gopher-image-object)
  330.     ( ?c   " <cal>"    gopher-unimplemented-object)
  331.     ( ?g   " <GIF>"    gopher-image-object)
  332.     )
  333.   "*Alist describing the types of gopher objects this client know about.
  334. The keys are the gopher type characters.
  335. The second element in each list is the string to tag onto the end
  336. of an object's description, to identify it to the user.
  337. The third element is the function to use to retrieve the object.
  338. It is called with two arguments: the gopher object to retrieve and
  339. the buffer which should be returned to when the user is done
  340. with this object."
  341.   :type '(repeat (list character string function))
  342.   :group 'object)
  343.  
  344.  
  345. ;;;
  346. ;;; The data structure describing a gopher object is a vector of five elements:
  347. ;;;    [ TYPE DESCR SELECTOR HOST PORT ]
  348. ;;;
  349. ;;;  TYPE is the type character.
  350. ;;;  DESCR is the human-readable description of the object.
  351. ;;;  SELECTOR is the opaque selector to be sent to HOST to retrieve the obj.
  352. ;;;  HOST is the name of the Internet host on which the object resides.
  353. ;;;  PORT is the TCP/IP port on which the host is listening.
  354. ;;;
  355. ;;;  The following macros set and fetch elements of this structure.
  356. ;;;  
  357.  
  358. (defconst gopher-object-length 5)
  359.  
  360. (defmacro gopher-object-type (object)
  361.   "Return the gopher type of OBJECT."
  362.   (` (aref (, object) 0)))
  363.  
  364. (defmacro gopher-object-descr (object)
  365.   "Return the gopher description of OBJECT."
  366.   (` (aref (, object) 1)))
  367.  
  368. (defmacro gopher-object-selector (object)
  369.   "Return the gopher selector string for OBJECT."
  370.   (` (aref (, object) 2)))
  371.  
  372. (defmacro gopher-object-host (object)
  373.   "Return the gopher hostname for OBJECT."
  374.   (` (aref (, object) 3)))
  375.  
  376. (defmacro gopher-object-port (object)
  377.   "Return the gopher TCP port number for OBJECT."
  378.   (` (aref (, object) 4)))
  379.  
  380.  
  381. (defmacro gopher-set-object-type (object type)
  382.   "Set the gopher type of OBJECT to TYPE."
  383.   (` (aset (, object) 0 (, type))))
  384.  
  385. (defmacro gopher-set-object-descr (object descr)
  386.   "Set the gopher description of OBJECT to DESCR."
  387.   (` (aset (, object) 1 (, descr))))
  388.  
  389. (defmacro gopher-set-object-selector (object selector)
  390.   "Set the gopher selector string for OBJECT to SELECTOR."
  391.   (` (aset (, object) 2 (, selector))))
  392.  
  393. (defmacro gopher-set-object-host (object host)
  394.   "Set the gopher hostname for OBJECT to HOST."
  395.   (` (aset (, object) 3 (, host))))
  396.  
  397. (defmacro gopher-set-object-port (object port)
  398.   "Set the gopher TCP port number for OBJECT to PORT."
  399.   (` (aset (, object) 4 (, port))))
  400.  
  401.  
  402. (defmacro gopher-retrieve-document-cleanly (args handle &rest body)
  403.   "Call gopher-retrieve-document with condition-case wrapped around, 
  404. applying HANDLE if appropriate."
  405.   (` (condition-case nil
  406.          (progn
  407.            (gopher-retrieve-document (,@ args))
  408.            (,@ body))
  409.        (error (, handle)))))
  410.  
  411.  
  412. ;;
  413. ;; buffer-local variables.
  414. ;; declared here to prevent warnings from the new byte-compiler.
  415. ;;
  416.  
  417. (defvar gopher-dir nil)
  418. (defvar gopher-last nil)
  419. (defvar gopher-obj nil)
  420. (defvar gopher-telnet-process-name nil)
  421. (defvar gopher-bookmark-buffer-tick nil)
  422. (defvar forms-accept-action nil)        
  423.  
  424.  
  425. ;;;;--------------------------------------------------------------------------
  426. ;;;; main dispatching logic.
  427. ;;;;
  428.  
  429. ;;;###autoload
  430. (defun gopher (&optional askserv)
  431.   "Start a gopher session.  With C-u, prompt for a gopher server."
  432.   (interactive "P")
  433.   (if askserv
  434.       (progn
  435.         (gopher-set-object-host
  436.          gopher-root-node
  437.          (read-string "Gopher server: "
  438.                       (gopher-object-host gopher-root-node)))
  439.  
  440.         (let (portstr port)
  441.           (while (not (numberp port))
  442.             (setq portstr
  443.                   (read-string "Port: "
  444.                                (int-to-string
  445.                                 (gopher-object-port gopher-root-node))))
  446.  
  447.             (setq port (condition-case nil
  448.                            (car (read-from-string portstr))
  449.                          (error nil)))
  450.  
  451.             (if (not (numberp port))
  452.                 (progn
  453.                   (ding)
  454.                   (message "Port must be numeric")
  455.                   (sit-for 1)))
  456.             )
  457.  
  458.           (gopher-set-object-port gopher-root-node port))))
  459.  
  460.   (gopher-read-bookmarks)
  461.  
  462.   (gopher-dispatch-object gopher-root-node nil))
  463.   
  464.  
  465.  
  466. ;;;###autoload
  467. (defun gopher-atpoint nil
  468.   "Try to interpret the text around point as a gopher bookmark, and dispatch
  469. to that object."
  470.   (interactive)
  471.  
  472.   (let (bkmk)
  473.     (save-excursion
  474.       (re-search-backward "^#[ \t]*$\\|^[ \t]*$\\|\\`")
  475.       (skip-chars-forward " \t\n")
  476.       (setq bkmk (gopher-parse-bookmark)))
  477.     (if bkmk
  478.     (progn
  479.       (gopher-read-bookmarks)
  480.       (gopher-dispatch-object bkmk nil))
  481.       (error "Illformed bookmark"))))
  482.  
  483.   
  484. (defun gopher-dispatch-object (obj lastbuf)
  485.   "Dispatch a gopher object depending on its type."
  486.   (let ((typedesc (assq (gopher-object-type obj) gopher-object-type-alist)))
  487.  
  488.     (if typedesc
  489.         (funcall (nth 2 typedesc) obj lastbuf)
  490.       (gopher-unimplemented-object obj lastbuf))))
  491.  
  492.  
  493. (defun gopher-unimplemented-object (obj lastbuf)
  494.   (error "unimplemented object type"))
  495.  
  496.  
  497. ;;;;--------------------------------------------------------------------------
  498. ;;;; utilities
  499. ;;;;
  500.  
  501. (defun gopher-next-field nil
  502.   "Returns as a string all chars between point and the next tab or newline.
  503. Point is advanced to after the tab (or to the end-of-line)."
  504.  
  505.   (let ((beg (point)) s)
  506.     (skip-chars-forward "^\t\n")
  507.     (setq s (buffer-substring beg (point)))
  508.     (if (eq (following-char) ?\t)
  509.         (forward-char))
  510.     s))
  511.  
  512.  
  513. ;; from GNUS
  514. (defun gopher-make-local-vars (&rest pairs)
  515.   ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the
  516.   ;; value.
  517.   (while pairs
  518.     (make-local-variable (car pairs))
  519.     (set (car pairs) (car (cdr pairs)))
  520.     (setq pairs (cdr (cdr pairs)))))
  521.  
  522.  
  523. (defun gopher-get-tmp-buf nil
  524.   "Get a temporary buffer in which to receive gopher output."
  525.   (or (bufferp gopher-tmp-buf)
  526.       (progn
  527.         (setq gopher-tmp-buf (get-buffer-create " *gopher-tmp*"))
  528.         (buffer-flush-undo gopher-tmp-buf)))
  529.   gopher-tmp-buf)
  530.  
  531.  
  532. (defun gopher-get-dir-buf (descr)
  533.   "Get a new buffer suitable for a gopher directory or document."
  534.   (let ((buf (generate-new-buffer (concat "*gopher*" descr))))
  535.     (buffer-flush-undo buf)
  536.     buf))
  537.  
  538. (fset 'gopher-get-doc-buf (symbol-function 'gopher-get-dir-buf))
  539.  
  540.  
  541. (defun gopher-trim-blanks (str)
  542.   "Remove leading and trailing blanks from STR."
  543.   (string-match "\\`[ \t\n]*" str)
  544.   (substring str
  545.              (match-end 0)
  546.              (string-match "[ \t\n]*\\'" str (match-end 0))))
  547.  
  548.  
  549. ;;;;--------------------------------------------------------------------------
  550. ;;;; directory handling
  551. ;;;;
  552.  
  553.  
  554. (defun gopher-directory-object (obj oldbuf)
  555.   "Retrieve and display a gopher directory."
  556.  
  557.   (let ((tmpbuf (gopher-get-tmp-buf))
  558.         (dirbuf (gopher-get-dir-buf (gopher-object-descr obj))))
  559.  
  560.     ;; Get the directory...
  561.     (gopher-retrieve-document-cleanly (tmpbuf
  562.                                        (gopher-object-selector obj)
  563.                                        (gopher-object-host     obj)
  564.                                        (gopher-object-port     obj))
  565.         
  566.         (progn
  567.           (kill-buffer dirbuf)
  568.           (error "Problems retrieving directory."))
  569.  
  570.       ;; Parse it and store our internal representation in gopher-dir.
  571.       (switch-to-buffer dirbuf)
  572.       (gopher-make-local-vars
  573.        'gopher-dir (gopher-parse-directory tmpbuf)
  574.        'gopher-obj obj
  575.        'gopher-last oldbuf)
  576.  
  577.       ;; Format it for your viewing pleasure.
  578.       (gopher-format-directory gopher-dir dirbuf)
  579.       (goto-char (point-min))
  580.       (if (> (- (point-max) (point)) 7) (forward-char 7))
  581.  
  582.       ;; Turn on directory mode and put the description in the mode line.
  583.       (gopher-directory-mode)
  584.       (setq mode-line-buffer-identification (concat "Gopher: "
  585.                                                     (gopher-object-descr obj)))
  586.       )))
  587.  
  588.  
  589. (defun gopher-parse-directory (buf)
  590.   "Parse the gopher directory in buffer BUF into our internal representation.
  591. Returns a vector of gopher objects."
  592.  
  593.   (save-excursion
  594.     (set-buffer buf)
  595.     (goto-char (point-min))
  596.  
  597.     (let* ((len (count-lines (point-min) (point-max)))
  598.            (dir (make-vector len nil))
  599.            (i 0))
  600.  
  601.       (while (not (eobp))
  602.         (aset dir i (gopher-parse-directory-line))
  603.         (setq i (1+ i))
  604.         (forward-line 1))
  605.  
  606.       dir)))
  607.  
  608.  
  609. (defun gopher-parse-directory-line nil
  610.   "Parse the line containing point as a gopher directory entry.
  611. Returns the corresponding gopher object."
  612.  
  613.   (let (type descr selector host port)
  614.     (beginning-of-line)
  615.     (setq type (following-char))
  616.     (forward-char)
  617.     (setq descr (gopher-next-field))
  618.     (setq selector (gopher-next-field))
  619.     (setq host (gopher-next-field))
  620.     (setq port (gopher-next-field))
  621.  
  622.     (if (string-match "^[0-9]+$" port)
  623.         (setq port (string-to-int port)))
  624.  
  625.     (vector type descr selector host port)))
  626.  
  627.  
  628. (defun gopher-format-directory (dir buf)
  629.   "Print the directory vector DIR into buffer BUF."
  630.  
  631.   (save-excursion
  632.     (set-buffer buf)
  633.     (erase-buffer)
  634.     (let ((i 0)
  635.           (len (length dir)))
  636.       (while (< i len)
  637.         (gopher-format-directory-line (aref dir i) (1+ i))
  638.         (setq i (1+ i)))
  639.  
  640.       )))
  641.  
  642.  
  643. (defun gopher-format-directory-line (obj ndx)
  644.   "Insert a line describing the gopher object OBJ into the current buffer.
  645. NDX is a numeric index to display to the left of the object description."
  646.  
  647.   (let ((ndx-str (int-to-string ndx))
  648.         (typedesc (assq (gopher-object-type obj) gopher-object-type-alist)))
  649.  
  650.     ;; display the index number.  use 5 digits, right-justified.
  651.     (if (< (length ndx-str) 5)
  652.         (insert (make-string (- 5 (length ndx-str)) ? )))
  653.     (insert ndx-str)
  654.     (insert ". ")
  655.  
  656.     ;; add the object description.
  657.     (insert (gopher-object-descr obj))
  658.  
  659.     ;; add a tag indicating the gopher object type.
  660.     (insert (if typedesc
  661.                 (nth 1 typedesc)
  662.               (concat " ???" (char-to-string (gopher-object-type obj)))))
  663.  
  664.     (insert "\n")))
  665.  
  666.  
  667. (defun gopher-directory-mode nil
  668.   "Gopher directory mode.
  669.  
  670. \\{gopher-directory-mode-map}
  671. "
  672.   (use-local-map gopher-directory-mode-map)
  673.   (setq major-mode 'gopher-directory-mode)
  674.   (setq mode-name "gopher dir")
  675.   (run-hooks 'gopher-directory-mode-hook)
  676.   (setq buffer-read-only t)
  677.  
  678.   (require 'mode-motion)
  679.   (make-local-variable 'mode-motion-hook)
  680.   (setq mode-motion-hook 'mode-motion-highlight-line)
  681.   )
  682.  
  683. ;;; keymap for directory mode
  684. (suppress-keymap gopher-directory-mode-map)
  685. (define-key gopher-directory-mode-map "\r" 'gopher-directory-choose)
  686. (define-key gopher-directory-mode-map " " 'gopher-directory-choose)
  687. (define-key gopher-directory-mode-map "l"  'gopher-last-node)
  688. (define-key gopher-directory-mode-map "q"  'gopher-last-node)
  689. (define-key gopher-directory-mode-map "u"  'gopher-last-node)
  690. (define-key gopher-directory-mode-map "="  'gopher-directory-show-object)
  691. (define-key gopher-directory-mode-map "Q"  'gopher-quit)
  692. (define-key gopher-directory-mode-map "f" 'gopher-directory-choose)
  693. (define-key gopher-directory-mode-map "e" 'gopher-directory-choose)
  694.  
  695. ; Virginia Peck <vapeck@cs>  Mon Aug 10 1992
  696. (define-key gopher-directory-mode-map "n"  'next-line)
  697. (define-key gopher-directory-mode-map "p"  'previous-line)
  698. ;;(define-key gopher-directory-mode-map "\C-xk"  'gopher-last-node)
  699.  
  700. ; Stewart Clamen <clamen@cs.cmu.edu>  Mon Aug 17 1992
  701. (define-key gopher-directory-mode-map "v"  'gopher-display-bookmarks)
  702. (define-key gopher-directory-mode-map "a"  'gopher-add-bookmark)
  703. (define-key gopher-directory-mode-map "\C-k"  'gopher-delete-bookmark)
  704. (define-key gopher-directory-mode-map "s" 'gopher-directory-save-bookmarks)
  705. (define-key gopher-directory-mode-map "\C-y" 'gopher-yank-bookmark)
  706.  
  707. (define-key gopher-directory-mode-map 'button2 'gopher-mouse-directory-choose)
  708. (define-key gopher-directory-mode-map 'button3 'gopher-directory-menu)
  709.  
  710.  
  711. (defvar gopher-directory-menu
  712.   '("Gopher Commands"
  713.     ["Select This Link" gopher-directory-choose t]
  714.     ["Goto Last Node" gopher-last-node t]
  715.     ["Show Object Internals" gopher-directory-show-object t]
  716.     ["Quit" gopher-quit t]
  717.     ))
  718.  
  719. (defun gopher-directory-menu (event)
  720.   (interactive "e")
  721.   (mouse-set-point event)
  722.   (beginning-of-line)
  723.   (popup-menu gopher-directory-menu))
  724.  
  725. (defun gopher-mouse-directory-choose (event arg)
  726.   (interactive "e\nP")
  727.   (mouse-set-point event)
  728.   (beginning-of-line)
  729.   (gopher-directory-choose arg))
  730.  
  731.  
  732. (defun gopher-directory-nth-obj (n)
  733.   "Returns the Nth object (starting at 1) in a gopher directory buffer."
  734.   (if (or (<= n 0) (> n (length gopher-dir)))
  735.       (error "Out of range."))
  736.   (aref gopher-dir (1- n)))
  737.  
  738.  
  739. (defun gopher-directory-n (arg)
  740.   "Return the index of the object specified by ARG (starting at 1).
  741. If ARG is nil, this is the index of the current line.
  742. Otherwise, it is the value of ARG (as a prefix argument)."
  743.   (if arg
  744.       (prefix-numeric-value arg)
  745.     (if (eq (point) (point-max))
  746.     (1+ (count-lines (point-min) (point-max)))
  747.       (count-lines (point-min) (1+ (point))))))
  748.  
  749.  
  750. (defun gopher-directory-obj (arg)
  751.   "Return the gopher object given by prefix arg ARG.
  752. If it is nil, return the object given by the line point is on.
  753. Otherwise, ARG is the index of the object."
  754.   (gopher-directory-nth-obj (gopher-directory-n arg)))
  755.  
  756.  
  757. (defun gopher-directory-choose (arg)
  758.   "Choose an item from the directory, and do whatever is appropriate
  759. based on the object's type.  Default is to choose the object given by the
  760. line the cursor is on.  With numeric prefix argument N, choose object N."
  761.   (interactive "P")
  762.   (gopher-dispatch-object (gopher-directory-obj arg) (current-buffer)))
  763.  
  764.  
  765. (defun gopher-directory-show-object (arg)
  766.   "Dump the internal information in a gopher object.
  767. With numeric prefix argument N, show information about the Nth object."
  768.   (interactive "P")
  769.   (let* ((obj (gopher-directory-obj arg))
  770.          (type (gopher-object-type obj))
  771.          (typespec (assq type gopher-object-type-alist))
  772.          (typetag (if typespec (nth 1 typespec) "?"))
  773.          (typeproc (if typespec (nth 2 typespec) "?")))
  774.     (with-output-to-temp-buffer "*Gopher object*"
  775.       (princ (format "Type        : %c   `%s'   %s\n" type typetag typeproc))
  776.       (princ (format "Description : %s\n" (gopher-object-descr    obj)))
  777.       (princ (format "Selector    : %s\n" (gopher-object-selector obj)))
  778.       (princ (format "Host        : %s\n" (gopher-object-host     obj)))
  779.       (princ (format "Port        : %s\n" (gopher-object-port     obj)))
  780.       (current-buffer)
  781.       ))
  782.   (shrink-window-if-larger-than-buffer (get-buffer-window "*Gopher object*"))
  783.  
  784.   ;; shrink-window-if-larger-than-buffer screws these up...
  785.   (set-buffer-modified-p nil)
  786.   (setq buffer-read-only t))
  787.  
  788.  
  789. (defun gopher-last-node nil
  790.   "Return to the previous gopher node.
  791. By convention, a gopher buffer has the local variable gopher-last which
  792. contains the buffer to which we should return."
  793.   (interactive)
  794.   (let ((oldbuf (current-buffer)))
  795.     (if gopher-last
  796.         (progn
  797.           (switch-to-buffer gopher-last)
  798.           (kill-buffer oldbuf)
  799.       (and (gopher-bookmark-directory-p)
  800.            (> gopher-bookmark-modified-tick gopher-bookmark-buffer-tick)
  801.            (let ((ppos (1- (gopher-directory-n nil))))
  802.          (gopher-format-bookmarks)
  803.          (forward-line ppos)
  804.          (if (> (- (point-max) (point)) 7) (forward-char 7)))))
  805.       (if (and gopher-support-bookmarks
  806.                gopher-bookmarks-modified
  807.                (y-or-n-p
  808.                 "Changes have been made to the Bookmark directory.  Save? "))
  809.           (gopher-save-bookmarks))
  810.       (kill-buffer oldbuf))))
  811.  
  812.  
  813. (defun gopher-directory-save-bookmarks ()
  814.   "Save the bookmark list."
  815.   (interactive)
  816.  
  817.   (if (not (gopher-bookmark-directory-p))
  818.       (error "This isn't the bookmark directory."))
  819.  
  820.   (gopher-save-bookmarks))
  821.  
  822.  
  823.  
  824. ;;; Gopher clean-up and quit.
  825. ;;; Originally from Thomas L|fgren <tde9104@abacus.hgs.se>
  826.  
  827. (defun gopher-quit nil
  828.   "Quit gopher, and kill all gopher buffers.
  829. If there are unsaved changes to your bookmark directory, you will be
  830. asked if you want to save them"
  831.   (interactive)
  832.   (if (y-or-n-p "Do you really want to kill all gopher buffers? ") 
  833.       (progn
  834.     (if (and gopher-support-bookmarks
  835.          gopher-bookmarks-modified
  836.          (y-or-n-p
  837.           "Changes have been made to the Bookmark directory.  Save? "))
  838.         (gopher-save-bookmarks))
  839.     (let ((buflist (buffer-list))
  840.           (case-fold-search t))
  841.       (while buflist
  842.         (if (eq (string-match "\\*gopher" (buffer-name (car buflist))) 0)
  843.         (kill-buffer (car buflist)))
  844.         (setq buflist (cdr buflist)))))))
  845.  
  846.  
  847. ;;;;--------------------------------------------------------------------------
  848. ;;;; bookmarks (Implemented originally by clamen@cs.cmu.edu)
  849. ;;;;
  850.  
  851.  
  852. (defun gopher-read-bookmarks ()
  853.   (cond ((null gopher-support-bookmarks))
  854.         ((or (equal gopher-support-bookmarks 'unix)
  855.              (equal gopher-support-bookmarks t))
  856.          (setq gopher-bookmarks 
  857.                (gopher-read-unix-bookmarks)))
  858.         ((stringp gopher-support-bookmarks)
  859.          (gopher-read-lisp-bookmarks gopher-support-bookmarks))
  860.         ((vectorp gopher-support-bookmarks)
  861.          (setq gopher-bookmarks gopher-support-bookmarks))
  862.         (t
  863.          (message "Illformed gopher-bookmarks, assuming none"))))
  864.  
  865.  
  866. (defun gopher-read-unix-bookmarks ()
  867.   "Read bookmarks out of ~/.gopherrc file."
  868.   (let ((rcfile "~/.gopherrc"))
  869.     (if (file-exists-p rcfile)
  870.         (let* ((rcbuf (find-file-noselect rcfile))
  871.                (bkmks (gopher-parse-bookmark-buffer rcbuf)))
  872.           (kill-buffer rcbuf)
  873.           (setq gopher-bookmarks-modified nil)
  874.       (setq gopher-bookmark-modified-tick
  875.         (1+ gopher-bookmark-modified-tick))
  876.           bkmks)
  877.       (message "No %s exists." rcfile)
  878.       nil)))
  879.  
  880. (defun gopher-parse-bookmark-buffer (buf)
  881.   "Read buffer containing bookmarks, formatted like ~.gopherrc 
  882. in UNIX gopher client."
  883.   (save-excursion
  884.     (set-buffer buf)
  885.     (goto-char (point-min))
  886.     (if (re-search-forward "^bookmarks:\n" (point-max) t)
  887.         (let (bkmk bkmks)
  888.           (while (setq bkmk (gopher-parse-bookmark))
  889.             (setq bkmks (cons bkmk bkmks)))
  890.           (apply 'vector (reverse bkmks))))))
  891.  
  892. (defun gopher-parse-bookmark-line (regexp end setf bkmk)
  893.   (save-excursion
  894.     (if (re-search-forward regexp end t)
  895.     (eval (list setf bkmk
  896.             (buffer-substring (match-beginning 1) (match-end 1))))
  897.       )))
  898.  
  899.  
  900. (defun gopher-parse-bookmark ()
  901.   "Read next bookmark.  Return a directory object."
  902.   (if (looking-at "^#$")
  903.       (forward-line))
  904.   (if (not (eobp))
  905.       (let ((end (save-excursion
  906.            (forward-line 5)
  907.            (point)))
  908.         (bkmk (make-vector 5 nil)))
  909.     (prog1
  910.         (and (gopher-parse-bookmark-line "^Type *= *\\(.+\\) *$" end
  911.                          'gopher-set-object-type bkmk)
  912.          (gopher-parse-bookmark-line "^Name *= *\\(.*\\) *$" end
  913.                          'gopher-set-object-descr bkmk)
  914.          (gopher-parse-bookmark-line "^Path *= *\\(.*\\) *$" end
  915.                          'gopher-set-object-selector bkmk)
  916.          (gopher-parse-bookmark-line "^Host *= *\\(.+\\) *$" end
  917.                          'gopher-set-object-host bkmk)
  918.          (gopher-parse-bookmark-line "^Port *= *\\(.+\\) *$" end
  919.                          'gopher-set-object-port bkmk)
  920.          (progn
  921.            (gopher-set-object-type
  922.             bkmk (string-to-char (gopher-object-type bkmk)))
  923.            (gopher-set-object-port
  924.             bkmk (string-to-int (gopher-object-port bkmk)))
  925.            bkmk))
  926.       (goto-char end))
  927.     )))
  928.  
  929. (defun gopher-format-bookmarks ()
  930.   "Make the current buffer (which is assumed to be a bookmark buffer)
  931. contain an up-to-date listing of the bookmark list."
  932.  
  933.   (let ((buffer-read-only nil))
  934.     (erase-buffer)
  935.     (setq gopher-dir gopher-bookmarks)
  936.  
  937.     ;; Format it for your viewing pleasure.
  938.     (gopher-format-directory gopher-dir (current-buffer))
  939.     (goto-char (point-min))
  940.     (if (> (- (point-max) (point)) 7) (forward-char 7))
  941.     (setq gopher-bookmark-buffer-tick gopher-bookmark-modified-tick)))
  942.  
  943. (defun gopher-display-bookmarks ()
  944.   "Retrieve and display the gopher bookmark directory."
  945.   (interactive)
  946.  
  947.   (if (> (length gopher-bookmarks) 0)
  948.       (let ((oldbuf (current-buffer))
  949.             (dirbuf (gopher-get-dir-buf "*Gopher Bookmarks*")))
  950.  
  951.         ;; Store our internal representation in gopher-dir.
  952.         (switch-to-buffer dirbuf)
  953.         (gopher-make-local-vars
  954.          'gopher-dir gopher-bookmarks
  955.      'gopher-bookmark-directory-p t
  956.      'gopher-bookmark-buffer-tick gopher-bookmark-modified-tick
  957.      'gopher-obj 'bookmark
  958.          'gopher-last oldbuf)
  959.  
  960.     (gopher-format-bookmarks)
  961.  
  962.         ;; Turn on directory mode and put the description in the mode line.
  963.         (gopher-directory-mode)
  964.         (setq mode-line-buffer-identification (concat "Gopher: *Bookmarks*"))
  965.         )
  966.     (error "No bookmarks supported.")))
  967.  
  968.  
  969. (defun gopher-save-bookmarks ()
  970.   "Save bookmarks."
  971.   (cond 
  972.    ((or (equal gopher-support-bookmarks 'unix)
  973.         (equal gopher-support-bookmarks t))
  974.     (gopher-save-unix-bookmarks))
  975.    ((stringp gopher-support-bookmarks)
  976.     (gopher-save-lisp-bookmarks gopher-support-bookmarks))
  977.    (t
  978.     (message "Illformed gopher-support-bookmarks, assuming none")))
  979.  
  980.   (setq gopher-bookmarks-modified nil))
  981.  
  982.  
  983. (defun gopher-save-unix-bookmarks ()
  984.   "Save bookmarks out to ~/.gopherrc file."
  985.   (save-excursion
  986.     (let* ((rcfile "~/.gopherrc")
  987.            (new-file-p (not (file-exists-p rcfile)))
  988.            (rcbuf (find-file-noselect rcfile)))
  989.       (set-buffer rcbuf)
  990.       (if new-file-p
  991.           (insert "bookmarks:\n")
  992.         (goto-char (point-min))
  993.         (if (re-search-forward "^bookmarks:\n" nil t)
  994.             (delete-region (point) (point-max))
  995.           (goto-char (point-max))
  996.           (insert "bookmarks:\n")))
  997.  
  998.       ;; Now, insert defined bookmarks into file
  999.   
  1000.       (let ((obj-count 0))
  1001.         (while (< obj-count (length gopher-bookmarks))
  1002.           (let ((obj (aref gopher-bookmarks obj-count)))
  1003.             (insert "#"
  1004.                     "\nType=" (gopher-object-type obj)
  1005.                     "\nName=" (gopher-object-descr obj)
  1006.                     "\nPath=" (gopher-object-selector obj)
  1007.                     "\nHost=" (gopher-object-host obj)
  1008.                     "\nPort=" (int-to-string (gopher-object-port obj))
  1009.                     "\n")
  1010.             (setq obj-count (1+ obj-count)))))
  1011.  
  1012.       (write-file rcfile))))
  1013.  
  1014.  
  1015. (defun gopher-add-bookmark (arg)
  1016.   "Add current object to menu of bookmarks.
  1017. With numeric prefix argument N, add Nth object."
  1018.   (interactive "P")
  1019.   (if (gopher-bookmark-directory-p)
  1020.       (error "That item is already a bookmark!")
  1021.     (let ((existing-bookmarks gopher-bookmarks)
  1022.           (new-bookmarks (make-vector (1+ (length gopher-bookmarks)) nil))
  1023.           (obj (copy-sequence (gopher-directory-obj arg)))
  1024.           (l (length gopher-bookmarks)))
  1025.       (gopher-set-object-descr
  1026.        obj
  1027.        (read-from-minibuffer "Node Name: "
  1028.                              (gopher-object-descr obj)))
  1029.       (aset new-bookmarks l obj)
  1030.       (while (> l 0)
  1031.         (progn (setq l (1- l))
  1032.                (aset new-bookmarks l (aref existing-bookmarks l))))
  1033.       (setq gopher-bookmarks new-bookmarks
  1034.             gopher-bookmarks-modified t
  1035.         gopher-bookmark-modified-tick (1+ gopher-bookmark-modified-tick))
  1036.       )))
  1037.  
  1038.  
  1039. (defun gopher-delete-bookmark (arg)
  1040.   "Delete current bookmark.
  1041. With numeric prefix argument N, delete Nth bookmark."
  1042.   (interactive "P")
  1043.   (if (not (gopher-bookmark-directory-p))
  1044.       (error "Can only delete object in Bookmark directory.")
  1045.     (let ((new-bookmarks (make-vector (1- (length gopher-bookmarks)) nil))
  1046.           (pos (1- (gopher-directory-n arg)))
  1047.           (l (length gopher-bookmarks))
  1048.           (i 0))
  1049.       (while (< i pos)
  1050.         (progn (aset new-bookmarks i (aref gopher-bookmarks i))
  1051.                (setq i (1+ i))))
  1052.       (while (< i (1- l))
  1053.         (progn (aset new-bookmarks i (aref gopher-bookmarks (1+ i)))
  1054.                (setq i (1+ i))))
  1055.       (setq gopher-killed-bookmark (aref gopher-bookmarks pos)
  1056.         gopher-bookmarks new-bookmarks
  1057.             gopher-dir new-bookmarks
  1058.             gopher-bookmarks-modified t
  1059.         gopher-bookmark-modified-tick (1+ gopher-bookmark-modified-tick))
  1060.       (let ((ppos (1- (gopher-directory-n nil))))
  1061.     (if (< pos ppos)
  1062.         (setq ppos (1- ppos)))
  1063.     (gopher-format-bookmarks)
  1064.     (goto-char (point-min))
  1065.     (forward-line ppos)
  1066.     (forward-char 7)))
  1067.     (if (= (point) (point-max)) (previous-line 1))
  1068. ;    (let ((buffer-read-only nil))
  1069. ;      (beginning-of-line 1)
  1070. ;      (kill-line 1)
  1071. ;      (if (= (point) (point-max)) (previous-line 1)))
  1072.     (if (zerop (length gopher-bookmarks))
  1073.         (gopher-last-node))))
  1074.  
  1075.  
  1076. (defun gopher-yank-bookmark (arg)
  1077.   "Yank the most recently killed bookmark at the current position.
  1078. With numeric prefix argument N, yank into position N."
  1079.   (interactive "P")
  1080.   (cond ((not (gopher-bookmark-directory-p))
  1081.      (error "Can only yank bookmark objects into bookmark directory."))
  1082.     ((null gopher-killed-bookmark)
  1083.      (error "No killed bookmark object"))
  1084.     (t
  1085.      (let* ((len (length gopher-bookmarks))
  1086.         (new-bookmarks (make-vector (1+ len) nil))
  1087.         (pos (1- (gopher-directory-n arg)))
  1088.         i)
  1089.  
  1090.        (if (or (< pos 0) (> pos (length gopher-bookmarks)))
  1091.            (error "Out of range."))
  1092.  
  1093.        (setq i (1- pos))
  1094.        (while (>= i 0)
  1095.          (aset new-bookmarks i (aref gopher-bookmarks i))
  1096.          (setq i (1- i)))
  1097.  
  1098.        (aset new-bookmarks pos gopher-killed-bookmark)
  1099.  
  1100.        (setq i pos)
  1101.        (while (< i len)
  1102.          (aset new-bookmarks (1+ i) (aref gopher-bookmarks i))
  1103.          (setq i (1+ i)))
  1104.  
  1105.        (setq gopher-bookmarks new-bookmarks
  1106.          gopher-bookmarks-modified t
  1107.          gopher-killed-bookmark nil
  1108.          gopher-bookmark-modified-tick
  1109.            (1+ gopher-bookmark-modified-tick))
  1110.  
  1111.        (let ((ppos (1- (gopher-directory-n nil))))
  1112.          (if (<= pos ppos)
  1113.          (setq ppos (1+ ppos)))
  1114.          (gopher-format-bookmarks)
  1115.          (goto-char (point-min))
  1116.          (forward-line ppos)
  1117.          (forward-char 7))
  1118.        ))))
  1119.        
  1120.  
  1121. (defun gopher-bookmark-directory-p ()
  1122.   "Return T if currently displaying Bookmark directory."
  1123.   gopher-bookmark-directory-p)
  1124. ;  (equal gopher-dir gopher-bookmarks))
  1125.  
  1126.  
  1127. (defun gopher-read-lisp-bookmarks (fn)
  1128.   "currently unsupported"
  1129.   (error "gopher-read-lisp-bookmark is not yet supported.  Sorry."))
  1130.  
  1131. (defun gopher-save-lisp-bookmarks (fn)
  1132.   "currently unsupported"
  1133.   (error "gopher-save-lisp-bookmark is not yet supported.  Sorry."))
  1134.  
  1135.  
  1136.  
  1137. ;;;;--------------------------------------------------------------------------
  1138. ;;;; gopher documents
  1139. ;;;;
  1140.  
  1141.  
  1142. (defun gopher-document-object (obj oldbuf &optional end-regexp)
  1143.   "Retrieve and display a gopher document.
  1144. Optional argument END-REGEXP is used if the data will not be ended by `.'."
  1145.  
  1146.   (let ((docbuf (gopher-get-doc-buf (gopher-object-descr obj))))
  1147.  
  1148.     ;; Snarf the data into the buffer.
  1149.     (gopher-retrieve-document-cleanly (docbuf
  1150.                                        (gopher-object-selector obj)
  1151.                                        (gopher-object-host     obj)
  1152.                                        (gopher-object-port     obj)
  1153.                                        end-regexp)
  1154.  
  1155.         (progn
  1156.           (kill-buffer docbuf)
  1157.           (error "Problems retrieving document."))
  1158.       
  1159.       ;; Turn on document mode and put the description in the mode line.
  1160.       (switch-to-buffer docbuf)
  1161.       (gopher-make-local-vars
  1162.        'gopher-obj obj
  1163.        'gopher-last oldbuf)
  1164.       (goto-char (point-min))
  1165.       (gopher-document-mode)
  1166.       (setq mode-line-buffer-identification (concat "Gopher: "
  1167.                                                     (gopher-object-descr obj)))
  1168.       )))
  1169.  
  1170.  
  1171. ;; keymap for document mode
  1172. (suppress-keymap gopher-document-mode-map)
  1173.  
  1174. ;Virginia Peck <vapeck@cs>  Mon Aug 10 21:44:35 1992
  1175. ;;(define-key gopher-document-mode-map "\C-xk"  'gopher-last-node)
  1176.  
  1177. (define-key gopher-document-mode-map "l"  'gopher-last-node)
  1178. (define-key gopher-document-mode-map "q"  'gopher-last-node)
  1179. (define-key gopher-document-mode-map "u"  'gopher-last-node)
  1180. (define-key gopher-document-mode-map " "  'scroll-up)
  1181. (define-key gopher-document-mode-map "\C-?"  'scroll-down)
  1182. (define-key gopher-document-mode-map "\r"  'gopher-scroll-one-line-up)
  1183.  
  1184.  
  1185. (defun gopher-document-mode nil
  1186.   "Gopher document mode.
  1187.  
  1188. \\{gopher-document-mode-map}
  1189. "
  1190.   (use-local-map gopher-document-mode-map)
  1191.   (setq major-mode 'gopher-document-mode)
  1192.   (setq mode-name "gopher doc")
  1193.   (run-hooks 'gopher-document-mode-hook)
  1194.   (setq buffer-read-only t))
  1195.  
  1196.  
  1197. ;; from gosmacs.el
  1198. (defun gopher-scroll-one-line-up (&optional arg)
  1199.   "Scroll the selected window up (forward in the text) one line (or N lines)."
  1200.   (interactive "p")
  1201.   (scroll-up (or arg 1)))
  1202.  
  1203.  
  1204. ;;;;--------------------------------------------------------------------------
  1205. ;;;; CSO handling.
  1206. ;;;;
  1207. ;;;; uses a subset of forms mode to handle data entry.
  1208. ;;;;
  1209.  
  1210. (defun gopher-cso-object (obj oldbuf)
  1211.   "Display a CSO lookup form."
  1212.  
  1213.   ;; The following will create a buffer displaying the form described
  1214.   ;; by the list in the last argument (cf. forms-mode).  When the user
  1215.   ;; accepts the data in the form (by pressing `C-c RET'), the function
  1216.   ;; gopher-do-cso will be called with the data the user supplied.
  1217.   (gopher-form (gopher-object-descr obj)
  1218.                'gopher-do-cso
  1219.                4
  1220.                '("====== phone directory lookup ======"
  1221.                  "\n Press `C-c RET' to lookup, `C-c l' to return to the last gopher object."
  1222.                  "\n (you must fill in at least one of the first three fields)"
  1223.                  "\n"
  1224.                  "Name    : "   1
  1225.                  "\n"
  1226.                  "Phone   : "   2
  1227.                  "\n"
  1228.                  "E-Mail  : "   3
  1229.                  "\n"
  1230.                  "Address : "   4
  1231.                  ))
  1232.  
  1233.   ;; Record gopher-last so gopher-last-node knows where to go.
  1234.   ;; Record gopher-obj so gopher-do-cso knows what server to query.
  1235.   (gopher-make-local-vars
  1236.    'gopher-last oldbuf
  1237.    'gopher-obj  obj))
  1238.  
  1239.  
  1240. (defconst gopher-cso-fields '("name" "phone" "email" "address")
  1241.   "Field names to use in CSO queries.")
  1242.  
  1243. (defun gopher-do-cso (vals)
  1244.   "Make a CSO query.  VALS is the data the user entered in the form,
  1245. as a list of strings."
  1246.  
  1247.   ;; Check that the required data was provided.
  1248.   (if (zerop (+ (length (nth 0 vals))
  1249.                 (length (nth 1 vals))
  1250.                 (length (nth 2 vals))))
  1251.       (error "Must specify name, phone, or email."))
  1252.  
  1253.   (let ((query "query")
  1254.         (fields gopher-cso-fields)
  1255.         (obj gopher-obj))
  1256.  
  1257.     ;; Form the query string
  1258.     (while vals
  1259.  
  1260.       (if (not (zerop (length (car vals))))
  1261.           (setq query (concat query " " (car fields) "=" (car vals))))
  1262.  
  1263.       (setq vals (cdr vals))
  1264.       (setq fields (cdr fields)))
  1265.  
  1266.     ;; Use this string as the object selector.
  1267.     (gopher-set-object-selector gopher-obj query)
  1268.  
  1269.     ;; Retrieve the data from the server.  Unlike gopher, the CSO data
  1270.     ;; does not use `.' as a terminator.
  1271.     (gopher-document-object gopher-obj (current-buffer) "^[2-9]")
  1272.  
  1273.     ;; Strip CSO control information from the buffer.
  1274.     (gopher-clean-cso-buffer obj)))
  1275.  
  1276.  
  1277. (defun gopher-clean-cso-buffer (obj)
  1278.   "Strip CSO control information from the current buffer."
  1279.  
  1280.   (let ((req "")
  1281.         (buffer-read-only nil)
  1282.         beg nreq)
  1283.     (goto-char (point-min))
  1284.     (insert "\n")
  1285.     (while (not (eobp))
  1286.       (cond ((and (>= (following-char) ?3) (<= (following-char) ?9))
  1287.              (delete-char 4)
  1288.              (insert (concat (gopher-object-selector obj) "\n")))
  1289.             
  1290.             ((eq (following-char) ?-)
  1291.              (delete-char 5)
  1292.              (setq beg (point))
  1293.              (skip-chars-forward "^:")
  1294.              (setq nreq (buffer-substring beg (point)))
  1295.              (goto-char beg)
  1296.              (or (string= req nreq)
  1297.                  (insert (concat "--------------------------"
  1298.                                  "-----------------------------\n")))
  1299.              (setq req nreq)
  1300.              (setq beg (point))
  1301.              (skip-chars-forward "^:")
  1302.              (forward-char)
  1303.              (delete-region beg (point)))
  1304.  
  1305.             (t
  1306.              (setq beg (point))
  1307.              (forward-line 1)
  1308.              (delete-region beg (point))
  1309.              (forward-line -1))
  1310.             )
  1311.       (forward-line 1))
  1312.  
  1313.     (goto-char (point-min))
  1314.     (delete-char 1)))
  1315.  
  1316.  
  1317. ;;;;--------------------------------------------------------------------------
  1318. ;;;; indices.
  1319. ;;;;
  1320. ;;;; To query an index, the search string is appended to the selector.
  1321. ;;;; The index returns a gopher directory.
  1322. ;;;;
  1323.  
  1324.  
  1325. (defun gopher-index-object (obj oldbuf)
  1326.   "Query a gopher directory object."
  1327.  
  1328.   ;; Get the search string from the user.
  1329.   (let ((str (read-from-minibuffer "Key: "))
  1330.         (newobj (copy-sequence obj)))
  1331.  
  1332.     ;; Append it to the selector and retrieve the modified object
  1333.     ;; like a directory.
  1334.     (setq str (gopher-trim-blanks str))
  1335.     (if (> (length str) 0)
  1336.         (progn
  1337.           (gopher-set-object-selector newobj
  1338.                                       (concat (gopher-object-selector obj) "\t"
  1339.                                               str))
  1340.           (gopher-directory-object newobj (current-buffer)))
  1341.       )))
  1342.  
  1343.  
  1344.  
  1345. ;;;;--------------------------------------------------------------------------
  1346. ;;;; telneting.
  1347. ;;;;
  1348.  
  1349. (defun gopher-telnet-object (obj oldbuf)
  1350.   "Start a telnet session to a gopher object.
  1351. If gopher-telnet-command is non-nil, then that is a command to start
  1352. a telnet session in a subprocess.  Otherwise, the emacs-lisp telnet
  1353. package is used."
  1354.   
  1355.   ;; make the telnet argument string
  1356.   (let ((arg (gopher-object-host obj))
  1357.         (port (gopher-object-port obj)))
  1358.     (if (not (zerop port))
  1359.         (setq arg (concat arg 
  1360.                           (if (eq system-type 'vax-vms)
  1361.                               "/port="
  1362.                             " ")
  1363.                           port)))
  1364.  
  1365.     (if gopher-telnet-command
  1366.  
  1367.         ;; start up telnet as a separate process
  1368.         (save-window-excursion
  1369.           (gopher-background
  1370.            (concat gopher-telnet-command " " arg)))
  1371.  
  1372.       ;; use telnet-mode
  1373.       (telnet arg)
  1374.       ;; set things up so we can get back to the last node.
  1375.       (gopher-make-local-vars
  1376.        'gopher-obj obj
  1377.        'gopher-last oldbuf
  1378.        'gopher-telnet-process-name (concat arg "-telnet"))
  1379.       (local-set-key "\C-cl" 'gopher-telnet-quit)
  1380.       (local-set-key "\C-xk" 'gopher-telnet-quit)
  1381.       )
  1382.  
  1383.     ;; show the login info to the user
  1384.     (if (not (zerop (length (gopher-object-selector obj))))
  1385.         (progn
  1386.           (beep)
  1387.           (message (concat 
  1388.                     "Login as: "
  1389.                     (gopher-object-selector obj)
  1390.                     ))
  1391.           ))
  1392.     ))
  1393.  
  1394.  
  1395. (defun gopher-telnet-quit nil
  1396.   "Clean up a telnet session and return to the previous gopher node."
  1397.   (interactive)
  1398.   (condition-case nil
  1399.       (delete-process gopher-telnet-process-name)
  1400.     (error t))
  1401.   (gopher-last-node))
  1402.  
  1403.  
  1404.  
  1405. ;;;;--------------------------------------------------------------------------
  1406. ;;;; Images/sounds.
  1407. ;;;;
  1408.  
  1409. (defun gopher-image-object (obj oldbuf)
  1410.   "Retrieve what we hope is an image and show it."
  1411.   (let (
  1412.      (showit (y-or-n-p "Display this item? "))
  1413.      (fname)
  1414.      (buf (gopher-get-doc-buf (gopher-object-descr obj))))
  1415.     (if showit
  1416.      (setq fname (make-temp-name "/tmp/gopherimg"))
  1417.       (setq fname(read-file-name "File to save in: ")))
  1418.     (gopher-retrieve-document-cleanly (buf
  1419.                        (gopher-object-selector obj)
  1420.                        (gopher-object-host     obj)
  1421.                        (gopher-object-port     obj)
  1422.                        'none)
  1423.     (progn
  1424.       (error "Problems retrieving object.")
  1425.       (kill-buffer buf))
  1426.  
  1427.       (save-excursion
  1428.     (set-buffer buf)
  1429.     (write-file fname))
  1430.       (kill-buffer buf)
  1431.       (if (and showit gopher-image-display-command)
  1432.  
  1433.       ;; Spawn a process to display the image.
  1434.       ;; But modify its sentinel so that the file we wrote
  1435.       ;; will get deleted when the process exits.
  1436.       (save-window-excursion
  1437.         (let ((p (gopher-background
  1438.               (concat gopher-image-display-command " " fname))))
  1439.           (set-process-sentinel p
  1440.             (` (lambda (process msg) 
  1441.              ((, (process-sentinel p)) process msg)
  1442.              (if (not (eq (process-status process) 'run))
  1443.                  (delete-file (, fname)))
  1444.              )))
  1445.           ))
  1446.     ))))
  1447.  
  1448.  
  1449.  
  1450. ;;;;--------------------------------------------------------------------------
  1451. ;;;; Various opaque objects.  Just save them in a file for now.
  1452. ;;;;
  1453.  
  1454. (defun gopher-binary-object (obj oldbuf)
  1455.   "Retrieve a gopher object and save it to a file,
  1456. without trying to interpret it in any way."
  1457.   (let ((fname (read-file-name "File to save in: "))
  1458.         (buf (gopher-get-doc-buf (gopher-object-descr obj))))
  1459.  
  1460.     (gopher-retrieve-document-cleanly (buf
  1461.                                        (gopher-object-selector obj)
  1462.                                        (gopher-object-host     obj)
  1463.                                        (gopher-object-port     obj)
  1464.                                        'none)
  1465.  
  1466.         (progn
  1467.           (error "Problems retrieving object.")
  1468.           (kill-buffer buf))
  1469.  
  1470.       (save-excursion
  1471.         (set-buffer buf)
  1472.         (write-file fname))
  1473.       (kill-buffer buf)
  1474.       )))
  1475.  
  1476.  
  1477. ;;;;--------------------------------------------------------------------------
  1478. ;;;; forms stuff
  1479. ;;;;
  1480. ;;;; Uses some of the internal routines from forms.el to present
  1481. ;;;; a form which is not associated with a file.
  1482. ;;;;
  1483.  
  1484. (defun gopher-form (form-name accept-action number-of-fields format-list)
  1485.   "Display a buffer containing a form for the user to enter data.
  1486. The form is described by NUMBER-OF-FIELDS and FORMAT-LIST (cf. forms-mode).
  1487. FORM-NAME is a string to put in the modeline.
  1488. When the user accepts the data in the form by pressing `C-c RET', the
  1489. function ACCEPT-ACTION is called with a list of the strings which
  1490. the user entered."
  1491.  
  1492.   (switch-to-buffer (generate-new-buffer "*gopher form*"))
  1493.  
  1494.   (gopher-make-local-vars
  1495.    'forms-format-list   format-list
  1496.    'forms-number-of-fields number-of-fields
  1497.    'forms-field-sep        "\t"
  1498.    'forms-read-only        nil
  1499.    'forms-multi-line       nil
  1500.    'forms--number-of-markers nil
  1501.    'forms--markers           nil
  1502.    'forms--format            nil
  1503.    'forms--parser            nil
  1504.    'forms--dynamic-text      nil
  1505.    'forms-fields             nil
  1506.    'forms-the-record-list    nil
  1507.    'forms-accept-action      accept-action
  1508.    )
  1509.  
  1510.   (forms--process-format-list)
  1511.   (forms--make-format)
  1512.   (forms--make-parser)
  1513.  
  1514.   (erase-buffer)
  1515.  
  1516.   ;; make local variables
  1517.   (make-local-variable 'forms--file-buffer)
  1518.   (make-local-variable 'forms--total-records)
  1519.   (make-local-variable 'forms--current-record)
  1520.   (make-local-variable 'forms--the-record-list)
  1521.   (make-local-variable 'forms--search-rexexp)
  1522.  
  1523.   ;; set the major mode indicator
  1524.   (setq major-mode 'gopher-form-mode)
  1525.   (setq mode-name "gopher form")
  1526.  
  1527.   (set-buffer-modified-p nil)
  1528.  
  1529.   (use-local-map gopher-form-mode-map)
  1530.  
  1531.   (forms--show-record (make-string (1- number-of-fields) ?\t))
  1532.  
  1533.   (run-hooks 'gopher-form-mode-hooks))
  1534.  
  1535.  
  1536. (defun gopher-form-accept nil
  1537.   (interactive)
  1538.  
  1539.   (funcall forms-accept-action (forms--parse-form)))
  1540.  
  1541. (define-key gopher-form-mode-map "\C-c\r"  'gopher-form-accept)
  1542. (define-key gopher-form-mode-map "\C-cl"   'gopher-last-node)
  1543.  
  1544.  
  1545. ;;;;--------------------------------------------------------------------------
  1546. ;;;; low-level communications routines
  1547. ;;;;
  1548.  
  1549.  
  1550. (defun gopher-retrieve-document (buf sel host port &optional end-regexp)
  1551.   "Retrieve a gopher object into BUF.
  1552. The object is identified by a SEL HOST PORT triple.
  1553. Optional argument END-REGEXP is used for data which is not `.'-terminated.
  1554. If END-REGEXP is non-nil and not a string, then it is assumed that
  1555. the data is binary, and reading will continue until the sender disconnects.
  1556. Returns NIL if an error occured during the attempt to retrieve the
  1557. document, otherwise T.
  1558. "
  1559.  
  1560.   ;; Default is single period termination.
  1561.   (or end-regexp (setq end-regexp "^\\.\r$"))
  1562.  
  1563.   (save-excursion
  1564.     (set-buffer buf)
  1565.     (erase-buffer)
  1566.  
  1567.     (let ((h (assoc host gopher-hostname-aliases)))
  1568.       (if h (setq host (cdr h))))
  1569.  
  1570.     ;; Open the connection to the server.
  1571.     ;; If we get an unknown service error, try looking the port up in
  1572.     ;; gopher-port-aliases.  If we find it there, try the connect again
  1573.     ;; with that translation.
  1574.     (let (wait
  1575.       (gopher-server-process
  1576.        (let (p (try-again t))
  1577.          (while try-again
  1578.            (setq try-again nil)
  1579.            (condition-case errinfo
  1580.            (setq p (open-network-stream "gopher" (current-buffer)
  1581.                         host port))
  1582.          (error (if (and (string-match "^Unknown service .*$"
  1583.                            (nth 1 errinfo))
  1584.                  (setq port (cdr (assoc port
  1585.                             gopher-port-aliases))))
  1586.                 (setq try-again t)
  1587.               (ding)
  1588.               (message "%s: %s" (nth 0 errinfo) (nth 1 errinfo))
  1589.               ))))
  1590.          p)))
  1591.  
  1592.       (cond (gopher-server-process
  1593.              
  1594.              ;; keep the emacs end-of-process status line out of the buffer
  1595.              (set-process-sentinel gopher-server-process 'gopher-sentinel)
  1596.  
  1597.              ;; send the selector to the server
  1598.              (process-send-string gopher-server-process (concat sel "\r\n"))
  1599.  
  1600.              ;; receive the response from the server
  1601.              ;; based on nntp.el from GNUS
  1602.              (setq wait t)
  1603.              (while wait
  1604.                (if (stringp end-regexp)
  1605.                    (progn
  1606.                      (goto-char (point-max))
  1607.                      (forward-line -1)))
  1608.                (if (and (stringp end-regexp)
  1609.                         (looking-at end-regexp))
  1610.                    (setq wait nil)
  1611.                  (if (not (memq (process-status gopher-server-process)
  1612.                 '(open run)))
  1613.                      (progn
  1614.                        (message "gopher: connection closed")
  1615.                        (setq wait nil))
  1616.                    (if gopher-debug-read
  1617.                        (message "gopher: Reading..."))
  1618.                    (cond (gopher-buggy-accept
  1619.                           (sit-for 1))
  1620.                          ((and (boundp 'epoch::version) epoch::version)
  1621.                           (accept-process-output gopher-server-process 2))
  1622.                          (t
  1623.                           (accept-process-output gopher-server-process))
  1624.                          )
  1625.                    (if gopher-debug-read
  1626.                        (message " ")))
  1627.                  ))
  1628.  
  1629.              ;; be sure the net connection has gone away...
  1630.              (condition-case nil
  1631.                  (delete-process gopher-server-process)
  1632.                (error t))
  1633.  
  1634.              ;; clean up the text buffer
  1635.              (if (stringp end-regexp)
  1636.                  (gopher-clean-text))
  1637.  
  1638.              t)
  1639.  
  1640.             (t nil))
  1641.       )))
  1642.  
  1643.  
  1644. ;;; adapted from GNUS
  1645. (defun gopher-clean-text ()
  1646.   "Decode text transmitted by gopher.
  1647. 0. Delete status line.
  1648. 1. Delete `^M' at end of line.
  1649. 2. Delete `.' at end of buffer (end of text mark).
  1650. 3. Delete `.' at beginning of line.   (does gopher want this?)"
  1651.  
  1652.   ;; Insert newline at end of buffer.
  1653.   (goto-char (point-max))
  1654.   (if (not (bolp))
  1655.       (insert "\n"))
  1656.   ;; Delete `^M' at end of line.
  1657.   (goto-char (point-min))
  1658.   (while (re-search-forward "\r[^\n]*$" nil t)
  1659.     (replace-match ""))
  1660. ;  (goto-char (point-min))
  1661. ;  (while (not (eobp))
  1662. ;    (end-of-line)
  1663. ;    (if (= (preceding-char) ?\r)
  1664. ;       (delete-char -1))
  1665. ;    (forward-line 1)
  1666. ;    )
  1667.   ;; Delete `.' at end of buffer (end of text mark).
  1668.   (goto-char (point-max))
  1669.   (forward-line -1)                     ;(beginning-of-line)
  1670.   (while (looking-at "^\\.$")
  1671.     (delete-region (point) (progn (forward-line 1) (point)))
  1672.     (forward-line -1))
  1673.   ;; Replace `..' at beginning of line with `.'.
  1674.   (goto-char (point-min))
  1675.   ;; (replace-regexp "^\\.\\." ".")
  1676.   (while (search-forward "\n.." nil t)
  1677.     (delete-char -1))
  1678.   )
  1679.  
  1680.  
  1681. (defun gopher-sentinel (proc status)
  1682.   nil)
  1683.  
  1684. (provide 'gopher)
  1685.  
  1686. ;;; gopher.el ends here
  1687.  
  1688. ;;;(gopher.el) Local Variables:
  1689. ;;;(gopher.el) eval: (put 'gopher-retrieve-document-cleanly 'lisp-indent-hook 2)
  1690. ;;;(gopher.el) End:
  1691.  
  1692.